home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Source Code
/
Pascal
/
Code Resources
/
Eclectic CDEFs
/
Gauss CDEF Folder
/
GaussCDEFStub.p
< prev
next >
Wrap
Text File
|
1997-03-05
|
42KB
|
1,008 lines
{ GaussCDEFStub }
{}
{ Stub control definition for the GaussCDEF control }
{}
{ Copyright © Sebastiano Pilla 1996 }
{ <mailto:case@tvol.it> }
{ Control definition procedure for displaying text within a window. Additional variations include: }
{ 1) displaying of the control value to use as a counter }
{ 2) drawing the text pointed to by the refCon field }
{ 3) drawing of the boundary rectangle }
{ 4) drawing always in the active state, ignoring any deactivation }
{ 5) drawing of a 3D-like inset or raised effect }
unit GaussCDEFStub;
interface
uses
Windows, Palettes, LowMem, Script, TextUtils, CDEFUtils, NeoTextBox;
function GaussCDEF (inVarCode: SInt16;
inControlHdl: ControlHandle;
inMessage: ControlDefProcMessage;
inParam: SInt32): SInt32;
implementation
const
kInGaussControlPart = 60; { Value returned for the testCntl message }
kDrawTitleAndValueVarCodeMask = $1; { Mask for drawing the control title and the control value in the refCon }
kDrawValueOnlyVarCodeMask = $2; { Mask for drawing only the value in the refCon }
kDrawTextFromRefConVarCodeMask = $4; { Mask for drawing only the text pointed to by the handle in the refCon }
kUseWindowFontVarCodeMask = $8; { Mask for drawing the text with the owning window font settings }
kDrawBoundingRectangleExtVarCodeMask = $100; { Mask for drawing the control enclosing rectangle }
kNeverDimControlExtVarCodeMask = $200; { Mask for drawing the control always in the active state }
kDraw3DEffectExtVarCodeMask = $400; { Mask for drawing a border (inset or raised) around the bar }
kUseStdColorsExtVarCodeMask = $800; { Mask for ignoring the 'cctb' colors }
kDeviceLoopFlags = 0; { Flags passed to DeviceLoop }
kMinimumColorDepth = 4; { Minimum depth for drawing in color, in bits per pixel }
kMinimum3DDepth = 8; { Minimum depth for drawing the 3D border, in bits per pixel }
kLowOrderByteMask = $00FF; { Mask for extracting the low-order byte of a 16-bit integer }
kHighOrderByteMask = $FF00; { Mask for extracting the high-order byte of a 16-bit integer }
kPlainFace = [];
kBoldFace = [bold];
kEffectThreshold = -100; { Checked against contrlMin to determine effect kind }
kDontSwapClipping = false;
kGaussCDEFFormatStr = '#,###,###,###'; { Format string with U.S. separators }
kItl4ResType = 'itl4';
kUSDefaultDecPointSep = '.'; { Default U.S. decimal point separator }
kUSDefaultThousandsSep = ','; { Default U.S. thousands separator }
type
GaussCDEFDataHandle = ^GaussCDEFDataPtr;
GaussCDEFDataPtr = ^GaussCDEFData;
GaussCDEFData = record
fDrawControlUPP: DeviceLoopDrawingUPP; { Pointer to drawing routine }
fBlitControlUPP: DeviceLoopDrawingUPP; { Pointer to blitting routine }
fOffscreenWorldPtr: GWorldPtr; { Pointer to offscreen world }
fTextHandle: Handle; { Handle to text }
fReferenceNumPartsPtr: NumberPartsPtr; { pointer to reference number parts table }
fUserNumPartsPtr: NumberPartsPtr; { pointer to user number parts table }
fBlackPattern: Pattern; { Standard black pattern }
fWhitePattern: Pattern; { Standard white pattern }
fDitherPattern: Pattern; { 50% black-50% white pattern used for dimming }
fControlOwnerForeColor: RGBColor; { Foreground color of the control's window }
fControlOwnerContentColor: RGBColor; { Content color of the control's window }
fBlackColor: RGBColor; { ($0000, $0000, $0000) black color }
fWhiteColor: RGBColor; { ($FFFF, $FFFF, $FFFF) white color }
fDimGrayColor: RGBColor; { ($7FFF, $7FFF, $7FFF) gray color for dimming }
fChiselGrayColor: RGBColor; { ($AAAA, $AAAA, $AAAA) chisel color as per develop 15 }
fVariationCode: SInt16; { Extended variation code }
fJustification: SInt16; { Justification for the text }
fSaveTxFont: SInt16; { Text font of control's port }
fSaveTxSize: SInt16; { Text size of control's port }
fSaveTxMode: SInt16; { Text transfer mode of control's port }
fSaveTxFace: Style; { Text face of control's port }
fHasGrayishTextOr: Boolean; { True if we can use the grayishTextOr transfer mode to dim text }
fOffscreenDrawAvailable: Boolean; { True if we can draw in the offscreen world, false otherwise }
end;
type
EffectKind = (eRaisedEffect, eNoEffect, eInsetEffect);
{ SetDrawingColors }
{}
{ Sets the appropriate colors for drawing the control }
{}
{ Entry: inControlHdl = handle to control }
{ inControlDataHdl = handle to private CDEF data }
{ inTargetDevice = device we're currently using }
{ inDimFlag = TRUE if the control should be dimmed, false otherwise }
{ inDrawBoundsFlag = TRUE if the bounding rectangle should be drawn, false otherwise }
{ Exit: outFrameColor = color for the frame part (if inDrawBoundsFlag = TRUE) }
{ outTextColor = color for the control's text }
{ outBodyColor = color for the control's body }
procedure SetDrawingColors (var outFrameColor, outTextColor, outBodyColor: RGBColor;
inControlHdl: ControlHandle;
inControlDataHdl: GaussCDEFDataHandle;
inTargetDevice: GDHandle;
inDimFlag, inDrawBoundsFlag: Boolean);
var
winBackColor: RGBColor;
auxCtlHdl: AuxCtlHandle;
useStdColorsFlag: Boolean;
begin
{ Check if the application wants to use the standard colors }
useStdColorsFlag := BAND(inControlDataHdl^^.fVariationCode, kUseStdColorsExtVarCodeMask) <> 0;
{ Retrieve the background color of the control's owner, stored by the BeginDraw routine }
winBackColor := inControlDataHdl^^.fControlOwnerContentColor;
{ Fetch the auxiliary control record if the application wants the 'cctb' colors and lock the color table }
if not useStdColorsFlag then
begin
if GetAuxiliaryControlRecord(inControlHdl, auxCtlHdl) then
;
if (auxCtlHdl <> nil) & (auxCtlHdl^^.acCTable <> nil) then
HLock(Handle(auxCtlHdl^^.acCTable))
else
useStdColorsFlag := true; { Fall back to the other case if the color table cannot be found }
end;
{ Set the frame color }
if inDrawBoundsFlag then
begin
if useStdColorsFlag then
outFrameColor := inControlDataHdl^^.fBlackColor
else
outFrameColor := auxCtlHdl^^.acCTable^^.ctTable[cFrameColor].rgb;
if inDimFlag then
if not GetGray(inTargetDevice, winBackColor, outFrameColor) then
outFrameColor := inControlDataHdl^^.fDimGrayColor;
end;
{ Set the text color; note that the grayishTextOr transfer mode is applied later, so isn't necessary to set it here }
if useStdColorsFlag then
outTextColor := inControlDataHdl^^.fBlackColor
else
outTextColor := auxCtlHdl^^.acCTable^^.ctTable[cTextColor].rgb;
if inDimFlag then
if not GetGray(inTargetDevice, winBackColor, outTextColor) then
outTextColor := inControlDataHdl^^.fDimGrayColor;
{ Set the body color; note that the dimming pattern (if inDimFlag = TRUE) is applied later }
if useStdColorsFlag then
outBodyColor := winBackColor
else
outBodyColor := auxCtlHdl^^.acCTable^^.ctTable[cBodyColor].rgb;
{ Unlock the color table if it was previously found and locked }
if not useStdColorsFlag then
HUnlock(Handle(auxCtlHdl^^.acCTable));
end;
{ DrawControlStructure }
{}
{ Draws the 3D effect, the control's frame and the control's body }
{}
{ Entry: ioControlBounds = control's boundary rectangle }
{ inFrameColor = color for the control's frame (if inDrawBoundsFlag = TRUE) }
{ inBodyColor = color for the control's body }
{ inControlDataHdl = handle to control's private data }
{ inEffectKind = kind of effect requested (if inDrawEffectFlag = TRUE) }
{ inDrawEffectFlag = TRUE if we should draw the 3D-like effect }
{ inDrawBoundsFlag = TRUE if we should draw the control's frame }
{ inDimFlag = TRUE if we should draw a dimmed control }
{ Exit: ioControlBounds = control's boundary rectangle, properly inset to draw the text }
{ Note: The relative positions of the 3D effect and the frame are changed when the requested effect kind }
{ changes. However, the Gauss CDEF draws the text always in the same position, regardless of the effect kind }
{ and the frame position. }
{ Note: I'm not proud of the way I coded this procedure. Hopefully I will improve it in the following versions }
procedure DrawControlStructure (var ioControlBounds: Rect;
inFrameColor, inBodyColor: RGBColor;
inControlDataHdl: GaussCDEFDataHandle;
inEffectKind: EffectKind;
inDrawEffectFlag, inDrawBoundsFlag, inDimFlag: Boolean);
var
winBackColor: RGBColor;
begin
{ Get the background color of the control's owner }
winBackColor := inControlDataHdl^^.fControlOwnerContentColor;
{ Set the correct background color }
RGBBackColor(winBackColor);
{ Determine if we'll really draw the effect }
inDrawEffectFlag := inDrawEffectFlag & EqualRGBColorComponents(winBackColor, kLightGrayRGBComp);
if inDrawEffectFlag then
begin
{ The calling application requested the 3D effect, so proceed with the drawing }
case inEffectKind of
eInsetEffect:
begin
{ The control is inactive, so frame a rectangle with the window's background color to }
{ maintain visual consistency with the other cases }
if inDimFlag then
begin
RGBForeColor(winBackColor);
FrameRect(ioControlBounds);
end
{ The control is active, so draw the inset effect; note that the inset effect is drawn 1 pixel }
{ outside of the frame }
else
begin
RGBForeColor(inControlDataHdl^^.fWhiteColor);
MoveTo(ioControlBounds.left + 1, ioControlBounds.bottom - 1);
LineTo(ioControlBounds.right - 1, ioControlBounds.bottom - 1);
LineTo(ioControlBounds.right - 1, ioControlBounds.top);
RGBForeColor(inControlDataHdl^^.fChiselGrayColor);
MoveTo(ioControlBounds.left, ioControlBounds.bottom - 1);
LineTo(ioControlBounds.left, ioControlBounds.top);
LineTo(ioControlBounds.right - 1, ioControlBounds.top);
end;
{ Draw the frame and the body; note that we don't need to check inDrawBoundsFlag here, because }
{ this is implied by inDrawEffectFlag = TRUE, and the DrawGaussControl did the check for us }
InsetRect(ioControlBounds, 1, 1);
RGBForeColor(inFrameColor);
FrameRect(ioControlBounds);
InsetRect(ioControlBounds, 1, 1);
RGBForeColor(inBodyColor);
PaintRect(ioControlBounds);
end;
eNoEffect:
begin
{ Draw only the frame and the body; we don't need to check the inDrawBoundsFlag because }
{ at this point we know that inDrawEffectFlag = TRUE }
RGBForeColor(inFrameColor);
FrameRect(ioControlBounds);
InsetRect(ioControlBounds, 1, 1);
RGBForeColor(inBodyColor);
PaintRect(ioControlBounds);
InsetRect(ioControlBounds, 1, 1);
end;
eRaisedEffect:
begin
{ Draw the frame first, then the effect one pixel inside (if possible); see the above discussion }
{ about the need to check inDrawBoundsFlag when inDrawEffectFlag = TRUE }
RGBForeColor(inFrameColor);
FrameRect(ioControlBounds);
InsetRect(ioControlBounds, 1, 1);
{ The control is inactive, so frame a rectangle with the window's background color to }
{ maintain visual consistency with the other cases }
if inDimFlag then
begin
RGBForeColor(inBodyColor);
FrameRect(ioControlBounds);
end
{ The control is active, so draw the raised effect }
else
begin
RGBForeColor(inControlDataHdl^^.fChiselGrayColor);
MoveTo(ioControlBounds.left + 1, ioControlBounds.bottom - 1);
LineTo(ioControlBounds.right - 1, ioControlBounds.bottom - 1);
LineTo(ioControlBounds.right - 1, ioControlBounds.top);
RGBForeColor(inControlDataHdl^^.fWhiteColor);
MoveTo(ioControlBounds.left, ioControlBounds.bottom - 1);
LineTo(ioControlBounds.left, ioControlBounds.top);
LineTo(ioControlBounds.right - 1, ioControlBounds.top);
end;
{ Draw the body }
InsetRect(ioControlBounds, 1, 1);
RGBForeColor(inBodyColor);
PaintRect(ioControlBounds);
end;
otherwise
;
end;
end
else
{ No effect was requested, so the drawing is *much* simpler to implement }
begin
if inDrawBoundsFlag then
begin
RGBForeColor(inFrameColor);
FrameRect(ioControlBounds);
InsetRect(ioControlBounds, 1, 1);
end;
RGBForeColor(inBodyColor);
PaintRect(ioControlBounds);
InsetRect(ioControlBounds, 1, 1);
end;
end;
{ ConvertValueToText }
{}
{ Obtains a text representation of the given value and adds it to the given text handle }
{}
{ Entry: inControlDataHdl = handle to control's private data }
{ inValue = 32-bit value }
{ ioTextHdl = handle to text on entry (allocated by the caller) }
{ ioTextLen = length (in bytes) of ioTextHdl on entry }
{ Exit: ioTextHdl = handle to text on entry plus value }
{ ioTextLen = length (in bytes) of ioTextHdl on exit }
{ Note: If an error occurs in this routine, or if the number-to-text conversion is wrong, we leave ioTextHdl }
{ and ioTextLen unchanged. }
{ Note: For references about the algorithm, see the develop 16 article "International Number Formatting" by }
{ Norbert Lindenberg. The Gauss CDEF implementation may not work on the 7.0 and 7.0.1 System version }
{ shipped in Netherlands and Czechoslovakia. }
procedure ConvertValueToText (inControlDataHdl: GaussCDEFDataHandle;
inValue: SInt32;
var ioTextHdl: Handle;
var ioTextLen: UInt32);
var
numFormat: NumFormatStringRec;
userFormatStr, valueStr: Str255;
positions: TripleInt;
itlHandle: Handle;
tableOffset, tableLength, mungResult: SInt32;
formatResult: FormatResultType;
begin
{ Explanation of the algorithm: }
{ 1) Convert our format string, built with the default U.S. separators, to an internal numeric representation }
{ using a reference parts table }
{ 2) Convert this internal numeric representation into a format string with the localized separators, using the }
{ user's parts table specified in the Numbers control panel }
{ 3) Format the number (the inValue parameter) using the user number parts table }
{ Extract the user number parts table }
itlHandle := nil;
GetIntlResourceTable(smCurrentScript, smNumberPartsTable, itlHandle, tableOffset, tableLength);
if itlHandle = nil then
Exit(ConvertValueToText);
BlockMoveData(Ptr(Ord4(itlHandle^) + tableOffset), inControlDataHdl^^.fUserNumPartsPtr, tableLength);
{ Extract the reference parts table from the U.S. 'itl4' resource, supposed to be always present }
itlHandle := GetResource(kItl4ResType, verUS);
if itlHandle = nil then
Exit(ConvertValueToText);
BlockMoveData(Ptr(Ord4(itlHandle^) + NItl4Handle(itlHandle)^^.defPartsOffset), inControlDataHdl^^.fReferenceNumPartsPtr, NItl4Handle(itlHandle)^^.defPartsLength);
{ Undo any change the user may have made to our reference parts table }
inControlDataHdl^^.fReferenceNumPartsPtr^.data[tokDecPoint].a[1] := kUSDefaultDecPointSep;
inControlDataHdl^^.fReferenceNumPartsPtr^.data[tokThousands].a[1] := kUSDefaultThousandsSep;
{ Convert our format string to an internal representation using the reference number parts table }
formatResult := FormatResultType(StringToFormatRec(kGaussCDEFFormatStr, inControlDataHdl^^.fReferenceNumPartsPtr^, numFormat));
{ Convert the just obtained internal representation to a format string using the user parts table }
if (formatResult = fFormatOK) or (formatResult = fBestGuess) then
formatResult := FormatResultType(FormatRecToString(numFormat, inControlDataHdl^^.fUserNumPartsPtr^, userFormatStr, positions));
{ Convert this last format string to another internal representation }
if (formatResult = fFormatOK) or (formatResult = fBestGuess) then
formatResult := FormatResultType(StringToFormatRec(userFormatStr, inControlDataHdl^^.fUserNumPartsPtr^, numFormat));
{ Finally, format the given number into a string, using our internal representation }
if (formatResult = fFormatOK) or (formatResult = fBestGuess) then
formatResult := FormatResultType(ExtendedToString(inValue, numFormat, inControlDataHdl^^.fUserNumPartsPtr^, valueStr));
{ Now we have a string that we can append to the given text using Munger }
if ((formatResult = fFormatOK) or (formatResult = fBestGuess)) & (Length(valueStr) > 0) then
begin
mungResult := Munger(ioTextHdl, ioTextLen, nil, 0, @valueStr[1], Length(valueStr));
if mungResult >= 0 then
ioTextLen := mungResult;
end;
end;
{ DrawGaussControl }
{}
{ DeviceLoop draw routine to draw the control in either the offscreen world or the control's port }
{}
{ Entry: inDepth = depth of current device }
{ inDeviceFlags = flags describing current device properties (unused) }
{ inTargetDevice = handle to current device }
{ inUserData = container for the control's handle }
procedure DrawGaussControl (inDepth: UInt16;
inDeviceFlags: SInt16;
inTargetDevice: GDHandle;
inUserData: SInt32);
var
controlBounds: Rect;
frameColor, textColor, bodyColor: RGBColor;
controlHdl: ControlHandle;
controlDataHdl: GaussCDEFDataHandle;
textLen: UInt32;
extVarCode, linesDrawn, endY, lhUsed: SInt16;
err: OSErr;
effKind: EffectKind;
dimFlag, drawBoundsFlag, drawEffectFlag: Boolean;
begin
{ Get the control handle and the data handle }
controlHdl := ControlHandle(inUserData);
controlDataHdl := GaussCDEFDataHandle(controlHdl^^.contrlData);
{ Get the variation code and the control's rect (in local coordinates relative to the control's window) }
extVarCode := controlDataHdl^^.fVariationCode;
controlBounds := controlHdl^^.contrlRect;
{ Set the drawing port to either the offscreen world, if available, or the control's port }
if controlDataHdl^^.fOffscreenDrawAvailable then
SetGWorld(controlDataHdl^^.fOffscreenWorldPtr, nil)
else
SetGWorld(CGrafPtr(controlHdl^^.contrlOwner), nil);
{ Always normalize the pen before drawing, to avoid unwanted side effects }
PenNormal;
{ Dim the control only if the 'never dim' variation is UNset and if the control is inactive }
dimFlag := (BAND(extVarCode, kNeverDimControlExtVarCodeMask) = 0) & (controlHdl^^.contrlHilite = kControlInactivePart);
{ Set a well-known clipping; again, this helps avoiding surprises }
ClipRect(controlBounds);
{ Erase the control rectangle, to simulate TETextBox behaviour }
EraseRect(controlBounds);
{ Determine if the calling appl. wants the control's bounding rectangle to be drawn }
drawBoundsFlag := BAND(extVarCode, kDrawBoundingRectangleExtVarCodeMask) <> 0;
if inDepth >= kMinimumColorDepth then
begin
{ The current device is deep enough for drawing our colors, so fetch them either from our data structure }
{ or from the auxiliary control record, if present }
SetDrawingColors(frameColor, textColor, bodyColor, controlHdl, controlDataHdl, inTargetDevice, dimFlag, drawBoundsFlag);
{ Determine if the calling application wants a 3D-like effect and what kind of effect. Note that drawing the 3D-like }
{ effect without drawing the control's bounding rectangle would not make much sense }
if drawBoundsFlag & (inDepth >= kMinimum3DDepth) then
drawEffectFlag := BAND(extVarCode, kDraw3DEffectExtVarCodeMask) <> 0
else
drawEffectFlag := false;
{ Check the contrlMin field against the threshold to see which kind of effect has been requested }
if drawEffectFlag then
begin
if controlHdl^^.contrlMin > kEffectThreshold then
effKind := eRaisedEffect
else if controlHdl^^.contrlMin = kEffectThreshold then
effKind := eNoEffect
else if controlHdl^^.contrlMin < kEffectThreshold then
effKind := eInsetEffect;
end
else
effKind := eNoEffect; { Pass eNoEffect to draw properly the frame }
{ Draw the frame, the 3D effect (if requested) and the body; note that this routine insets controlBounds }
{ by the correct amount of pixels to always draw the text in the correct position, even if the control rectangle }
{ intersects multiple screens with different depths }
DrawControlStructure(controlBounds, frameColor, bodyColor, controlDataHdl, effKind, drawEffectFlag, drawBoundsFlag, dimFlag);
{ Setup the colors for drawing the text }
RGBForeColor(textColor);
RGBBackColor(controlDataHdl^^.fControlOwnerContentColor);
end
else
begin
{ Black-&-white or 4-colors device: the controlBounds rectangle is framed with a white pattern to maintain }
{ consistency with the other case and to keep the text aligned if the control rectangle intersects multiple screens }
{ with different depths; then the rectangle is inset by 1 pixel in both directions and is framed with the frame pattern }
{ (if requested) }
PenPat(controlDataHdl^^.fWhitePattern);
FrameRect(controlBounds);
InsetRect(controlBounds, 1, 1);
if drawBoundsFlag then
begin
if dimFlag then
PenPat(controlDataHdl^^.fDitherPattern)
else
PenPat(controlDataHdl^^.fBlackPattern);
end
else
PenPat(controlDataHdl^^.fWhitePattern);
FrameRect(controlBounds);
InsetRect(controlBounds, 2, 2);
{ Setup the 'colors' for drawing the text }
ForeColor(blackColor);
BackColor(whiteColor);
end;
{ Inset again by 1 pixel only in the horizontal direction, to provide enough spacing between the frame and the }
{ text }
InsetRect(controlBounds, 1, 0);
{ Clip everything outside the newly inset control's rectangle }
ClipRect(controlBounds);
{ Setup the correct font, size and style for drawing the text }
if BAND(extVarCode, kUseWindowFontVarCodeMask) = 0 then
begin
TextFont(LMGetSysFontFam);
TextSize(LMGetSysFontSize);
TextFace(kPlainFace);
end
else
begin
TextFont(controlDataHdl^^.fSaveTxFont);
TextSize(controlDataHdl^^.fSaveTxSize);
TextFace(controlDataHdl^^.fSaveTxFace);
end;
{ Use grayishTextOr to dim if it's available; otherwise, dim with the 'old' method, calling PaintRect with }
{ PenMode(srcBic) later }
if dimFlag & controlDataHdl^^.fHasGrayishTextOr then
TextMode(grayishTextOr)
else
TextMode(srcOr);
if BAND(extVarCode, kDrawTextFromRefConVarCodeMask) <> 0 then
begin
{ If this varCode is set, then allocating the text and storing its handle in the refCon is the responsibility of }
{ the calling application. We just fetch the control's refCon, hoping to not end up into hyperspace }
controlDataHdl^^.fTextHandle := Handle(controlHdl^^.contrlRfCon);
textLen := GetHandleSize(controlDataHdl^^.fTextHandle);
end
else
begin
{ No text in refCon, so allocating it is our responsibility; check first what the calling application wants from us }
{ We need to draw the title if the kDrawTitleAndValue variation is set or the kDrawValueOnly variation is clear }
if (BAND(extVarCode, kDrawTitleAndValueVarCodeMask) <> 0) or (BAND(extVarCode, kDrawValueOnlyVarCodeMask) = 0) then
begin
textLen := Length(controlHdl^^.contrlTitle);
if textLen > 0 then
err := PtrToHand(@controlHdl^^.contrlTitle[1], controlDataHdl^^.fTextHandle, textLen);
{ Insert the text representing the value, if requested; we need to call the routine ConvertValueToText each }
{ time we draw, to respond properly to script system switches (for example, if the user switches from the }
{ Roman script to the Japanese script) }
if BAND(extVarCode, kDrawTitleAndValueVarCodeMask) <> 0 then
ConvertValueToText(controlDataHdl, controlHdl^^.contrlRfCon, controlDataHdl^^.fTextHandle, textLen);
end
else if BAND(extVarCode, kDrawValueOnlyVarCodeMask) <> 0 then
begin
{ Allocate a zero-sized handle to be filled later by ConvertValueToText }
textLen := 0;
controlDataHdl^^.fTextHandle := NewHandleClear(textLen);
if MemError = noErr then
ConvertValueToText(controlDataHdl, controlHdl^^.contrlRfCon, controlDataHdl^^.fTextHandle, textLen);
end;
end;
{ Lock the text to avoid problems }
HLock(controlDataHdl^^.fTextHandle);
{ Call NeoTextBox to draw the text }
linesDrawn := NeoTextBox(controlDataHdl^^.fTextHandle^, textLen, controlBounds, controlDataHdl^^.fJustification, 0, endY, lhUsed, kDontSwapClipping);
{ Unlock the text }
HUnlock(controlDataHdl^^.fTextHandle);
{ Do not keep the text allocated across calls, but only if the kDrawTextFromRefCon variation is clear }
if BAND(extVarCode, kDrawTextFromRefConVarCodeMask) = 0 then
begin
DisposeHandle(controlDataHdl^^.fTextHandle);
controlDataHdl^^.fTextHandle := nil;
end;
{ Dim the text with the 'old' method }
if dimFlag & (not controlDataHdl^^.fHasGrayishTextOr) then
begin
PenPat(controlDataHdl^^.fDitherPattern);
PenMode(srcBic);
PaintRect(controlBounds);
end;
end;
{ BlitGaussControl }
{}
{ DeviceLoop draw routine to copy the control drawing from the offscreen world to the control's port }
{}
{ Entry: inDepth = depth of current device }
{ inDeviceFlags = flags describing current device properties (unused) }
{ inTargetDevice = handle to current device (unused) }
{ inUserData = container for the control's handle }
procedure BlitGaussControl (inDepth: UInt16;
inDeviceFlags: SInt16;
inTargetDevice: GDHandle;
inUserData: SInt32);
var
controlBounds: Rect;
controlDataHdl: GaussCDEFDataHandle;
offWorldPtr: GWorldPtr;
controlPort: CGrafPtr;
begin
{ Get the control's data, the control's port and the control's rect }
controlDataHdl := GaussCDEFDataHandle(ControlHandle(inUserData)^^.contrlData);
controlPort := CGrafPtr(ControlHandle(inUserData)^^.contrlOwner);
controlBounds := ControlHandle(inUserData)^^.contrlRect;
{ Proceed only if the offscreen world is available }
if controlDataHdl^^.fOffscreenDrawAvailable then
begin
offWorldPtr := controlDataHdl^^.fOffscreenWorldPtr;
{ The offscreen world's pixMap has already been locked by the caller, so we set the port }
{ to the control's owner, set the foreground color to black and background color to white to avoid colorization }
{ by CopyBits and start blitting }
SetGWorld(controlPort, nil);
RGBForeColor(controlDataHdl^^.fBlackColor);
RGBBackColor(controlDataHdl^^.fWhiteColor);
CopyBits(GrafPtr(offWorldPtr)^.portBits, GrafPtr(controlPort)^.portBits, offWorldPtr^.portRect, controlBounds, srcCopy, nil);
end;
end;
{ BeginDraw }
{}
{ Responds to the drawCntl message by saving the current port, color, ecc. settings, by activating ours and }
{ by calling DeviceLoop to draw the control }
{}
{ Entry: inControlHdl = handle to current control }
procedure BeginDraw (inControlHdl: ControlHandle);
var
saveForeColor, saveBackColor: RGBColor;
savePen: PenState;
saveClip, controlRgn: RgnHandle;
auxWinHdl: AuxWinHandle;
savePort, controlPort: CGrafPtr;
saveDevice: GDHandle;
controlDataHdl: GaussCDEFDataHandle;
extVarCode: SInt16;
err: OSErr;
begin
{ Exit immediately if our custom data isn't available }
controlDataHdl := GaussCDEFDataHandle(inControlHdl^^.contrlData);
if controlDataHdl = nil then
Exit(BeginDraw);
{ Save current settings (port, clipping, colors, ecc.) }
GetGWorld(savePort, saveDevice);
controlPort := CGrafPtr(inControlHdl^^.contrlOwner);
SetGWorld(controlPort, nil);
GetForeColor(saveForeColor);
GetBackColor(saveBackColor);
GetPenState(savePen);
{ Now the current port is the control's port, and we intersect its clipping region with our control rectangle; if this }
{ intersection is empty then exit without drawing anything. This indeed means that all our drawing would be clipped out }
controlRgn := NewRgn;
saveClip := NewRgn;
if (saveClip <> nil) and (controlRgn <> nil) then
begin
GetClip(saveClip);
RectRgn(controlRgn, inControlHdl^^.contrlRect);
{ Intersect the current clip region with the control's rectangle: if this intersection is empty then dispose of our }
{ regions and exit }
SectRgn(saveClip, controlRgn, controlRgn);
if EmptyRgn(controlRgn) then
begin
DisposeRgn(saveClip);
DisposeRgn(controlRgn);
SetGWorld(savePort, saveDevice);
Exit(BeginDraw);
end
else
{ All right: set the clip region to the previously calculated intersection and go ahead }
SetClip(controlRgn);
end
else
{ Bad, bad: we don't have enough memory to allocate 2 regions, so exit }
begin
SetGWorld(savePort, saveDevice);
Exit(BeginDraw);
end;
{ Lock our data to avoid problems }
HLock(Handle(controlDataHdl));
{ Get a copy of our extended variation code }
extVarCode := controlDataHdl^^.fVariationCode;
{ Read the justification from the contrlValue field }
controlDataHdl^^.fJustification := inControlHdl^^.contrlValue;
{ Save the text settings of the control's owner (they're always used by the DrawGaussControl routine }
controlDataHdl^^.fSaveTxFont := controlPort^.txFont;
controlDataHdl^^.fSaveTxSize := controlPort^.txSize;
controlDataHdl^^.fSaveTxFace := controlPort^.txFace;
controlDataHdl^^.fSaveTxMode := controlPort^.txMode;
{ Dimming with the 'cctb' colors requires informations about the foreground color of the control's window, so }
{ store it into our data to avoid another couple of Get/SetGWorld calls later }
if BAND(extVarCode, kUseStdColorsExtVarCodeMask) = 0 then
if (BAND(extVarCode, kNeverDimControlExtVarCodeMask) = 0) & (inControlHdl^^.contrlHilite = kControlInactivePart) then
controlDataHdl^^.fControlOwnerForeColor := saveForeColor;
{ Store into our data the content color of the control's window, because we will need it to frame the }
{ control's bounds when not drawing the inset border; we try to not use the saved back color because it isn't reliable }
if GetAuxWin(WindowPtr(controlPort), auxWinHdl) then
;
if (auxWinHdl <> nil) & (auxWinHdl^^.awCTable <> nil) then
begin
HLock(Handle(auxWinHdl^^.awCTable));
controlDataHdl^^.fControlOwnerContentColor := auxWinHdl^^.awCTable^^.ctTable[wContentColor].rgb;
HUnlock(Handle(auxWinHdl^^.awCTable));
end
else
controlDataHdl^^.fControlOwnerContentColor := saveBackColor;
{ Create the offscreen drawing world }
err := CreateControlOffscreenWorld(inControlHdl, controlDataHdl^^.fOffscreenWorldPtr);
{ Examine the offscreen world to see if it has been created successfully }
if (err = noErr) and (controlDataHdl^^.fOffscreenWorldPtr <> nil) then
controlDataHdl^^.fOffscreenDrawAvailable := LockPixels(GetGWorldPixMap(controlDataHdl^^.fOffscreenWorldPtr));
{ Call DeviceLoop to draw the control either in the offscreen world (then blitting it to the control's port) or directly }
{ into the control's port }
if controlDataHdl^^.fOffscreenDrawAvailable then
begin
{ Draw the control in the offscreen world }
DeviceLoop(controlPort^.visRgn, controlDataHdl^^.fDrawControlUPP, SInt32(inControlHdl), kDeviceLoopFlags);
{ Copy the newly drawn control from the offscreen world to the control's port }
DeviceLoop(controlPort^.visRgn, controlDataHdl^^.fBlitControlUPP, SInt32(inControlHdl), kDeviceLoopFlags);
UnlockPixels(GetGWorldPixMap(controlDataHdl^^.fOffscreenWorldPtr));
DisposeGWorld(controlDataHdl^^.fOffscreenWorldPtr);
controlDataHdl^^.fOffscreenWorldPtr := nil;
controlDataHdl^^.fOffscreenDrawAvailable := false;
end
else
{ The offscreen world is not accessible, so we draw in the control's port anyway }
DeviceLoop(controlPort^.visRgn, controlDataHdl^^.fDrawControlUPP, SInt32(inControlHdl), kDeviceLoopFlags);
{ Restore the previously saved settings, unlock our data and exit }
TextFont(controlDataHdl^^.fSaveTxFont);
TextSize(controlDataHdl^^.fSaveTxSize);
TextFace(controlDataHdl^^.fSaveTxFace);
TextMode(controlDataHdl^^.fSaveTxMode);
SetClip(saveClip);
if saveClip <> nil then
DisposeRgn(saveClip);
if controlRgn <> nil then
DisposeRgn(controlRgn);
RGBForeColor(saveForeColor);
RGBBackColor(saveBackColor);
SetPenState(savePen);
SetGWorld(savePort, saveDevice);
HUnlock(Handle(controlDataHdl));
end;
{ InitControlData }
{}
{ Allocates and initializes the control's private data }
{ Note that if the kDrawTextFromRefCon variation is set we don't allocate any memory for the text. We }
{ consider this text's storage to be the responsibility of the calling application, to allow for flexibility (so }
{ that the calling application isn't forced to display only one text for the entire lifespan of this control) and to allow }
{ the application check the memory allocation for the text (IM-Macintosh Toolbox Essentials specifies that a CDEF should }
{ always respond with 0 to the initCntl message, so there's no means to report a failed allocation to the calling application). }
{}
{ Entry: inControlHdl = handle to current control }
{ inVarCode = variation code of current control }
procedure InitControlData (inControlHdl: ControlHandle;
inVarCode: SInt16);
var
theDataHdl: GaussCDEFDataHandle;
drawUPP, blitUPP: DeviceLoopDrawingUPP;
response: SInt32;
err: OSErr;
titleLength: SInt16;
begin
theDataHdl := nil;
{ Allocate memory for the control's data }
theDataHdl := GaussCDEFDataHandle(NewHandleClear(SizeOf(GaussCDEFData)));
err := MemError;
{ If the allocation was successful then fill in the fields, else punt }
if (err = noErr) and (theDataHdl <> nil) then
begin
{ Lock the data to avoid problems (the following calls are supposed to move memory) }
HLock(Handle(theDataHdl));
{ Store the draw and blit procedures }
drawUPP := NewDeviceLoopDrawingProc(@DrawGaussControl);
theDataHdl^^.fDrawControlUPP := drawUPP;
blitUPP := NewDeviceLoopDrawingProc(@BlitGaussControl);
theDataHdl^^.fBlitControlUPP := blitUPP;
{ The initial text justification is the contrlValue field }
theDataHdl^^.fJustification := inControlHdl^^.contrlValue;
{ Retrieve the extended variation codes from the contrlMax field and add them to the 'real' variation codes }
inVarCode := BOR(BAND(inControlHdl^^.contrlMax, kHighOrderByteMask), inVarCode);
{ Eliminate here the combinations of variation codes that are not allowed }
{ kDrawTextFromRefCon, kDrawTitleAndValue, kDrawValueOnly cannot appear together; we must choose only one, with }
{ the following priorities: 1) kDrawValueOnly 2) kDrawTitleAndValue 3) kDrawTextFromRefCon }
{ kDraw3DEffect requires kDrawBoundingRectangle, so if the latter is clear we clear the former also }
if BAND(inVarCode, kDrawValueOnlyVarCodeMask) <> 0 then
if BAND(inVarCode, kDrawTitleAndValueVarCodeMask + kDrawTextFromRefConVarCodeMask) <> 0 then
inVarCode := BAND(inVarCode, BNOT(kDrawTitleAndValueVarCodeMask + kDrawTextFromRefConVarCodeMask));
if BAND(inVarCode, kDrawTitleAndValueVarCodeMask) <> 0 then
if BAND(inVarCode, kDrawTextFromRefConVarCodeMask) <> 0 then
inVarCode := BAND(inVarCode, BNOT(kDrawTextFromRefConVarCodeMask));
if BAND(inVarCode, kDraw3DEffectExtVarCodeMask) <> 0 then
if BAND(inVarCode, kDrawBoundingRectangleExtVarCodeMask) = 0 then
inVarCode := BAND(inVarCode, BNOT(kDraw3DEffectExtVarCodeMask));
{ Store the massaged variation codes into the data structure }
theDataHdl^^.fVariationCode := inVarCode;
{ Allocate the memory for the two number parts tables used to convert numbers to text. I'd like to check }
{ for storage allocation errors, but a CDEF can only return 0 from the initCntl message }
if (BAND(inVarCode, (kDrawTitleAndValueVarCodeMask + kDrawValueOnlyVarCodeMask)) <> 0) then
begin
theDataHdl^^.fReferenceNumPartsPtr := NumberPartsPtr(NewPtrClear(SizeOf(NumberParts)));
theDataHdl^^.fUserNumPartsPtr := NumberPartsPtr(NewPtrClear(SizeOf(NumberParts)));
end;
{ Store the patterns; getting them via Resource Mgr. calls helps insulating us from using the evil }
{ QuickDraw globals }
GetIndPattern(theDataHdl^^.fBlackPattern, sysPatListID, kBlackPatternIndex);
GetIndPattern(theDataHdl^^.fWhitePattern, sysPatListID, kWhitePatternIndex);
GetIndPattern(theDataHdl^^.fDitherPattern, sysPatListID, kGrayPatternIndex);
{ Store the colors; note that the foreground and background colors of the control's window are stored }
{ by the BeginDraw procedure }
SetRGBColor(theDataHdl^^.fBlackColor, kBlackColorRGBComp, kBlackColorRGBComp, kBlackColorRGBComp);
SetRGBColor(theDataHdl^^.fWhiteColor, kWhiteColorRGBComp, kWhiteColorRGBComp, kWhiteColorRGBComp);
SetRGBColor(theDataHdl^^.fDimGrayColor, kDimGrayColorRGBComp, kDimGrayColorRGBComp, kDimGrayColorRGBComp);
{ This color is calculated only if the variation code specifies that we should draw the 3D effect }
if BAND(inVarCode, kDraw3DEffectExtVarCodeMask) <> 0 then
SetRGBColor(theDataHdl^^.fChiselGrayColor, kChiselGrayColorRGBComp, kChiselGrayColorRGBComp, kChiselGrayColorRGBComp);
{ Check if we can use the grayishTextOr transfer mode }
err := Gestalt(gestaltQuickDrawFeatures, response);
theDataHdl^^.fHasGrayishTextOr := (err = noErr) & BTST(response, gestaltHasGrayishTextOr);
{ Unlock data }
HUnlock(Handle(theDataHdl));
end;
{ Store the initialized data in the contrlData field; note that even the NIL handle of an unsuccessful }
{ allocation is stored, because is checked by the draw routine that exits if encounters such a handle }
inControlHdl^^.contrlData := Handle(theDataHdl);
end;
{ DisposeControlData }
{}
{ Disposes of all the private data created at initialization time }
{}
{ Entry: inControlHdl = handle to control }
procedure DisposeControlData (inControlHdl: ControlHandle);
var
theDataHdl: GaussCDEFDataHandle;
begin
theDataHdl := GaussCDEFDataHandle(inControlHdl^^.contrlData);
{ Go ahead only if our data is not NIL }
if theDataHdl <> nil then
begin
{ Dispose of the draw and blit UPPs }
DisposeRoutineDescriptor(theDataHdl^^.fDrawControlUPP);
DisposeRoutineDescriptor(theDataHdl^^.fBlitControlUPP);
{ Dispose of the title text if we allocated it, i.e. if the calling application specified a variation code }
{ other than kDrawTextFromRefCon }
if BAND(theDataHdl^^.fVariationCode, kDrawTextFromRefConVarCodeMask) = 0 then
if theDataHdl^^.fTextHandle <> nil then
DisposeHandle(theDataHdl^^.fTextHandle);
{ Dispose of our GWorld }
if theDataHdl^^.fOffscreenWorldPtr <> nil then
DisposeGWorld(theDataHdl^^.fOffscreenWorldPtr);
{ Dispose of our NumberParts tables }
if theDataHdl^^.fReferenceNumPartsPtr <> nil then
DisposePtr(Ptr(theDataHdl^^.fReferenceNumPartsPtr));
if theDataHdl^^.fUserNumPartsPtr <> nil then
DisposePtr(Ptr(theDataHdl^^.fUserNumPartsPtr));
{ Finally, dispose of the data itself and set it to NIL to avoid multiple disposal }
DisposeHandle(Handle(theDataHdl));
theDataHdl := nil;
end;
end;
{ GaussCDEF }
{}
{ Main entry point for the control definition function. Dispatches the messages to the }
{ appropriate subroutines }
{}
{ Entry: inVarCode = variation of control to handle }
{ inControlHdl = handle to ControlRecord describing the current control }
{ inMessage = identifies the subfunction requested }
{ inParam = variable value, depending on inMessage }
{ Exit: function result = variable value, depending on inMessage }
function GaussCDEF (inVarCode: SInt16;
inControlHdl: ControlHandle;
inMessage: ControlDefProcMessage;
inParam: SInt32): SInt32;
var
returnValue: SInt32;
ctrlRecState: SignedByte;
begin
{ Don't waste time if we're called with a NIL control handle (this should not happen anyway) }
if inControlHdl = nil then
Exit(GaussCDEF);
{ Lock down our control for the whole drawing time }
ctrlRecState := HGetState(Handle(inControlHdl));
HLock(Handle(inControlHdl));
{ Return 0 as default from our defproc (we don't have indicators) }
returnValue := 0;
{ Dispatch the current message to the appropriate subroutine }
case inMessage of
{ Draw the control (only if it's visible) }
drawCntl:
if inControlHdl^^.contrlVis <> 0 then
BeginDraw(inControlHdl);
{ Initializes the control's data }
initCntl:
InitControlData(inControlHdl, inVarCode);
{ Disposes of the control's data }
dispCntl:
DisposeControlData(inControlHdl);
{ Return kInGaussControlPart if the click is inside the control's rect }
testCntl:
if PtInRect(Point(inParam), inControlHdl^^.contrlRect) then
returnValue := kInGaussControlPart;
{ Return the control's rectangle as a region, in 32-bit addressing mode }
calcCntlRgn:
RectRgn(RgnHandle(inParam), inControlHdl^^.contrlRect);
{ Return the control's rectangle as a region, in 24-bit addressing mode; note that IM-Toolbox Essentials }
{ p. 5-112 says that we should clear the high-order bit before calculating the region, but does not specify }
{ that the region handle we return must be confined to the low 3 bytes of inParam }
calcCRgns:
if BAND(inParam, kClearHighByteMask) = 0 then
RectRgn(RgnHandle(StripAddress(inParam)), inControlHdl^^.contrlRect);
otherwise
;
end;
{ Unlock the control and return }
HSetState(Handle(inControlHdl), ctrlRecState);
GaussCDEF := returnValue;
end;
end.